home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tcl7.4 / tests / switch.test < prev    next >
Encoding:
Text File  |  1994-12-18  |  4.8 KB  |  171 lines
  1. # Commands covered:  switch
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright (c) 1993 The Regents of the University of California.
  8. # Copyright (c) 1994 Sun Microsystems, Inc.
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # @(#) switch.test 1.4 94/12/17 16:20:28
  14.  
  15. if {[string compare test [info procs test]] == 1} then {source defs}
  16.  
  17. test switch-1.1 {simple patterns} {
  18.     switch a a {format 1} b {format 2} c {format 3} default {format 4}
  19. } 1
  20. test switch-1.2 {simple patterns} {
  21.     switch b a {format 1} b {format 2} c {format 3} default {format 4}
  22. } 2
  23. test switch-1.3 {simple patterns} {
  24.     switch x a {format 1} b {format 2} c {format 3} default {format 4}
  25. } 4
  26. test switch-1.4 {simple patterns} {
  27.     switch x a {format 1} b {format 2} c {format 3}
  28. } {}
  29. test switch-1.5 {simple pattern matches many times} {
  30.     switch b a {format 1} b {format 2} b {format 3} b {format 4}
  31. } 2
  32. test switch-1.6 {simple patterns} {
  33.     switch default a {format 1} default {format 2} c {format 3} default {format 4}
  34. } 2
  35. test switch-1.7 {simple patterns} {
  36.     switch x a {format 1} default {format 2} c {format 3} default {format 4}
  37. } 4
  38.  
  39. test switch-2.1 {single-argument form for pattern/command pairs} {
  40.     switch b {
  41.     a {format 1}
  42.     b {format 2}
  43.     default {format 6}
  44.     }
  45. } {2}
  46. test switch-2.2 {single-argument form for pattern/command pairs} {
  47.     list [catch {switch z {a 2 b}} msg] $msg
  48. } {1 {extra switch pattern with no body}}
  49.  
  50. test switch-3.1 {-exact vs. -glob vs. -regexp} {
  51.     switch -exact aaaab {
  52.     ^a*b$    {concat regexp}
  53.     *b    {concat glob}
  54.     aaaab    {concat exact}
  55.     default    {concat none}
  56.     }
  57. } exact
  58. test switch-3.2 {-exact vs. -glob vs. -regexp} {
  59.     switch -exact -regexp aaaab {
  60.     ^a*b$    {concat regexp}
  61.     *b    {concat glob}
  62.     aaaab    {concat exact}
  63.     default    {concat none}
  64.     }
  65. } regexp
  66. test switch-3.3 {-exact vs. -glob vs. -regexp} {
  67.     switch -glob aaaab {
  68.     ^a*b$    {concat regexp}
  69.     *b    {concat glob}
  70.     aaaab    {concat exact}
  71.     default    {concat none}
  72.     }
  73. } glob
  74. test switch-3.4 {-exact vs. -glob vs. -regexp} {
  75.     switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
  76.         aaaab {concat exact} default {concat none}
  77. } exact
  78. test switch-3.5 {-exact vs. -glob vs. -regexp} {
  79.     switch -- -glob {
  80.     ^g.*b$    {concat regexp}
  81.     -*    {concat glob}
  82.     -glob    {concat exact}
  83.     default {concat none}
  84.     }
  85. } exact
  86. test switch-3.6 {-exact vs. -glob vs. -regexp} {
  87.     list [catch {switch -foo a b c} msg] $msg
  88. } {1 {bad option "-foo": should be -exact, -glob, -regexp, or --}}
  89.  
  90. test switch-4.1 {error in executed command} {
  91.     list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
  92.         $msg $errorInfo
  93. } {1 {Just a test} {Just a test
  94.     while executing
  95. "error "Just a test""
  96.     ("a" arm line 1)
  97.     invoked from within
  98. "switch a a {error "Just a test"} default {format 1}"}}
  99. test switch-4.2 {error: not enough args} {
  100.     list [catch {switch} msg] $msg
  101. } {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
  102. test switch-4.3 {error: pattern with no body} {
  103.     list [catch {switch a b} msg] $msg
  104. } {1 {extra switch pattern with no body}}
  105. test switch-4.4 {error: pattern with no body} {
  106.     list [catch {switch a b {format 1} c} msg] $msg
  107. } {1 {extra switch pattern with no body}}
  108. test switch-4.5 {error in default command} {
  109.     list [catch {switch foo a {error switch1} b {error switch 3} \
  110.         default {error switch2}} msg] $msg $errorInfo
  111. } {1 switch2 {switch2
  112.     while executing
  113. "error switch2"
  114.     ("default" arm line 1)
  115.     invoked from within
  116. "switch foo a {error switch1} b {error switch 3}  default {error switch2}"}}
  117.  
  118. test switch-5.1 {errors in -regexp matching} {
  119.     list [catch {switch -regexp aaaab {
  120.     *b    {concat glob}
  121.     aaaab    {concat exact}
  122.     default    {concat none}
  123.     }} msg] $msg
  124. } {1 {couldn't compile regular expression pattern: ?+* follows nothing}}
  125.  
  126. test switch-6.1 {backslashes in patterns} {
  127.     switch -exact {\a\$\.\[} {
  128.     \a\$\.\[    {concat first}
  129.     \a\\$\.\\[    {concat second}
  130.     \\a\\$\\.\\[    {concat third}
  131.     {\a\\$\.\\[}    {concat fourth}
  132.     {\\a\\$\\.\\[}    {concat fifth}
  133.     default        {concat none}
  134.     }
  135. } third
  136. test switch-6.2 {backslashes in patterns} {
  137.     switch -exact {\a\$\.\[} {
  138.     \a\$\.\[    {concat first}
  139.     {\a\$\.\[}    {concat second}
  140.     {{\a\$\.\[}}    {concat third}
  141.     default        {concat none}
  142.     }
  143. } second
  144.  
  145. test switch-7.1 {"-" bodies} {
  146.     switch a {
  147.     a -
  148.     b -
  149.     c {concat 1}
  150.     default {concat 2}
  151.     }
  152. } 1
  153. test switch-7.2 {"-" bodies} {
  154.     list [catch {
  155.     switch a {
  156.         a -
  157.         b -
  158.         c -
  159.     }
  160.     } msg] $msg
  161. } {1 {no body specified for pattern "a"}}
  162. test switch-7.3 {"-" bodies} {
  163.     list [catch {
  164.     switch a {
  165.         a -
  166.         b -foo
  167.         c -
  168.     }
  169.     } msg] $msg
  170. } {1 {invalid command name "-foo"}}
  171.